00100	COMMENT ⊗   VALID 00002 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002
00500	C00008 ENDMK
00600	C⊗;
     

00100	
00200	TITLE FR80 -- FORTRAN PLOT ROUTINES FOR FR-80 OUTPUT
00300	
00400	COMMENT ⊗
00500	
00600		APLOT(X,Y,UPDOWN) ←
00700			 IF ABS(UPDOWN)=2 THEN AVECT(X+FR80X0,Y+FR80Y0)
00800			 ELSE IF ABS(UPDOWN)=3 THEN AIVECT(X+FR80X0,Y+FR80Y0);
00900			 IF UPDOWN<0 THEN <FR80X0←X;FR80Y0←Y;>
01000		OUTCMD(CMD)  puts out one command on channel 17.
01100		OUTCML(CMDL) does outcmd on successive words starting at
01200			    CMDL until a negative word is seen.
01300		INFR80(DEV,FID,EXT) initializes FR80 output on the named file
01400			on channel 17.  
01500		RLFR80 releases channel 17.
01600		CMD ← FR80EC(<bits 3-8>,<bits 9-17>);  (bits 0:2 get set to 2)
01700		CMD ← FR80CD(<bits 4-6>,<bits 7-17>);  checkpoint delimiter format
01800	⊗
01900	INTERNAL APLOT,OUTCMD,OUTCML,INFR80,RLFR80,FR80EC,FR80CD,FR80X0,FR80Y0
02000		
02100	ARG← 16
02200	
02300	CMD ← 0
02400	A ← 1
02500	B ← 2
02600	C ← 3
02700	
02800	XC ←← 0	;X COORD
02900	YC ←← 1 ;Y COORD
03000	UPDOWN ←← 2;
03100	
03200	
03300	APLOT:	0		;BECAUSE OF BLECHEROUS FORTRAN CALL
03400		MOVE	CMD,@XC(ARG)
03500		ADD	CMD,FR80X0 	;ADD OFFSET
03600		SKIPGE	@UPDOWN(ARG)	;CORRECTING OFFSET?
03700		MOVEM	CMD,FR80X0	;YES
03800		ANDI	CMD,37777 	;TRUNCATE IT
03900		MOVM	A,@UPDOWN(ARG)	;
04000		CAIE	A,2		;ERROR CHECK
04100		CAIN	A,3		;
04200		SKIPA
04300		OUTSTR	[ASCIZ / ILLEGAL VALUE FOR UPDOWN IN CALL TO APLOT.
04400	INVISIBLE VECTOR DRAWN/]
04500		CAIN	A,2		;IF NOT A 2, THEN INVIS
04600		TROA	CMD,400000	;AN AVECT X-PART
04700		TRO	CMD,100000	;AN AIVECT X-PART
04800		JSA	ARG,OUTCMD	;PUT IT OUT
04900		JUMP	CMD
05000		MOVE	CMD,@YC(ARG)	;
05100		ADD	CMD,FR80Y0	;
05200		SKIPGE	CMD,@UPDOWN(ARG)
05300		MOVEM	CMD,FR80Y0	;UPDATE
05400		ANDI	CMD,37777	;
05500		TRO	CMD,40000	;SAY THE Y BIT IS ON
05600		JSA	ARG,OUTCMD	;PUT IT OUT
05700		JUMP	CMD
05800		JRA	ARG,3(ARG)	;RETURN
05900	
06000	OP ←← 0
06100	VAL ←← 1
06200	
06250	FR80EC:	0
06300		LDB	CMD,[POINT 6,@OP(ARG),=35]	;OP PART
06400		LSH	CMD,=9
06500		LDB	A,[POINT =9,@VAL(ARG),=35]	;VAL PART
06600		TRO	CMD,200000(A)	;
06700		JRA	ARG,2(ARG)	;RETURN
06800	
06850	FR80CD:	0
06900		LDB	CMD,[POINT 3,@OP(ARG),=35]
07000		LSH	CMD,=11
07100		MOVE	A,@VAL(ARG)
07200		DPB	A,[POINT =11,CMD,35]
07300		JRA	ARG,2(ARG)
07400	
07500	OUTCML:	0			;PUTS OUT A WHOLE LIST (-1) TERMINATES
07600		MOVEI	A,@(ARG)	;PICK UP POINTER TO LIST
07700	OCML.X:	SKIPGE	(A)		;IS IT VALID
07800		JRA	ARG,1(ARG)	;NO--RETURN
07900		JSA	ARG,OUTCMD	;
08000		JUMP	(A)		;A POINTS AT A GOOD ONE
08100		AOJA	A,OCML.X	;GO BACK
08200	
08300	OUTCMD:	0			;FORTRAN CALL FOR ONE CMD
08400		MOVE	CMD,@(ARG)
08500	OUT.XX:	SOSGE	FR80BH+2		;ANY LEFT IN THIS BUFFER??
08600		JRST	.+3
08700		IDPB	CMD,FR80BH+1	;
08800		JRA	ARG,1(ARG)	;RETURN
08900		OUT	17,
09000		JRST	OUT.XX		;NOW PUT THINGS OUT
09100		OUTSTR	[ASCIZ /OUTPUT ERROR ON CHANNEL 17 (FR80)/]
09200		HALT	1(ARG)
09300	
09400	DEV ←← 0			;SIXBIT DEVICE
09500	FID ←← 1			;SIXBIT FILEID
09600	EXT ←← 2
09700	
09800	
09900	INFR80: 0
10000		SKIPN	A,@DEV(ARG)
10100		MOVSI	A,'DSK'
10200		MOVEM	A,FR80DV
10300		OPEN	17,FR80BK
10400		JRST	[ OUTSTR [ASCIZ /OPEN FAILED FOR FR80 OUTPUT (CHANNEL 17)/]
10500		         HALT	3(ARG)]	;RETURN
10600		OUTBUF	17,6		;GET SOME BUFFERS
10700		MOVEI	A,(<POINT =18,0>)
10800		HRLM	A,FR80BH+1	;MUNCH BYTE COUNT
10900		SKIPN	A,@FID(ARG)
11000		MOVE	A,[SIXBIT /FR80/]
11100		MOVEM	A,FR80FI
11200		SKIPN	A,@EXT(ARG)
11300		MOVSI	A,'F80'
11400		MOVEM	A,FR80EX
11500		ENTER	17,FR80FI	;ENTER
11600		JRST	[ OUTSTR [ASCIZ /ENTER FAILED ON FR80 OUTPUT FILE/]
11700			HALT	3(ARG)]	;JUST RETURN
11800		MOVEI	CMD,20000	; 2↑13 = 2↑14/2 = CENTER OF SCREEN
11900		MOVEM	CMD,FR80X0
12000		SETZM	FR80Y0
12100		JRA	ARG,3(ARG)	;RETURN 
12200	
12300	RLFR80:	0
12400		RELEASE	17,
12500		JRA	ARG,(ARG)
12600	
12700	FR80X0:	0		;X & Y OFFSETS
12800	FR80Y0:	0
12900	
13000	FR80BH:	0	;BUFFER HEADER
13100		0
13200		0
13300	
13400	FR80FI:	0	;LOOKUP BLOCK
13500	FR80EX:	0
13600		0
13700		0
13800	
13900	FR80BK:	0	;OPEN BLOCK
14000	FR80DV:	0
14100		XWD FR80BH,0
14200	END